home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 8: LINUX Games / Linux Cubed Series 8 - LINUX Games.iso / games / muds / lpmud312.tar / lpmud312 / postlang.y < prev    next >
Text File  |  1992-02-10  |  52KB  |  1,789 lines
  1. /*
  2.  * These are token values that needn't have an associated code for the
  3.  * compiled file
  4.  */
  5.  
  6. %token F_CASE F_DEFAULT F_RANGE
  7.  
  8. %union
  9. {
  10.     int number;
  11.     unsigned int address;    /* Address of an instruction */
  12.     char *string;
  13.     short type;
  14.     struct { int key; char block; } case_label;
  15.     struct function *funp;
  16. }
  17.  
  18. %type <number> assign F_NUMBER constant F_LOCAL_NAME expr_list
  19. %type <number> const1 const2 const3 const4 const5 const6 const7 const8 const9
  20. %type <number> lvalue_list argument type basic_type optional_star expr_list2
  21. %type <number> type_modifier type_modifier_list opt_basic_type block_or_semi
  22. %type <number> argument_list
  23. %type <string> F_IDENTIFIER F_STRING string_con1 string_constant function_name
  24.  
  25. %type <case_label> case_label
  26.  
  27. /* The following symbos return type information */
  28.  
  29. %type <type> function_call lvalue string cast expr28 expr01 comma_expr
  30. %type <type> expr2 expr211 expr1 expr212 expr213 expr24 expr22 expr23 expr25
  31. %type <type> expr27 expr28 expr24 expr3 expr31 expr4 number expr0
  32. %%
  33.  
  34. all: program;
  35.  
  36. program: program def possible_semi_colon
  37.        |     /* empty */ ;
  38.  
  39. possible_semi_colon: /* empty */
  40.                    | ';' { yyerror("Extra ';'. Ignored."); };
  41.  
  42. inheritance: type_modifier_list F_INHERIT F_STRING ';'
  43.         {
  44.             struct object *ob;
  45.             struct inherit inherit;
  46.             int initializer;
  47.  
  48.             ob = find_object2($3);
  49.             if (ob == 0) {
  50.             inherit_file = $3;
  51.             /* Return back to load_object() */
  52.             YYACCEPT;
  53.             }
  54.             free($3);
  55.             if (ob->flags & O_APPROVED)
  56.             approved_object = 1;
  57.             inherit.prog = ob->prog;
  58.             inherit.function_index_offset =
  59.             mem_block[A_FUNCTIONS].current_size /
  60.                 sizeof (struct function);
  61.             inherit.variable_index_offset =
  62.             mem_block[A_VARIABLES].current_size /
  63.                 sizeof (struct variable);
  64.             add_to_mem_block(A_INHERITS, &inherit, sizeof inherit);
  65.             copy_variables(ob->prog, $1);
  66.             initializer = copy_functions(ob->prog, $1);
  67.             if (initializer > 0) {
  68.             struct function *funp;
  69.             int f;
  70.             f = define_new_function("::__INIT", 0, 0, 0, 0, 0);
  71.             funp = FUNCTION(f);
  72.             funp->offset = mem_block[A_INHERITS].current_size /
  73.                 sizeof (struct inherit) - 1;
  74.             funp->flags = NAME_STRICT_TYPES |
  75.                 NAME_INHERITED | NAME_HIDDEN;
  76.             funp->type = TYPE_VOID;
  77.             funp->function_index_offset = initializer;
  78.             transfer_init_control();
  79.             ins_f_byte(F_CALL_FUNCTION_BY_ADDRESS);
  80.             ins_short(f);
  81.             ins_byte(0);    /* Actual number of arguments */
  82.             ins_f_byte(F_POP_VALUE);
  83.             add_new_init_jump();
  84.             }
  85.         }
  86.  
  87. number: F_NUMBER
  88.     {
  89.         if ( $1 == 0 ) {
  90.         ins_f_byte(F_CONST0); $$ = TYPE_ANY;
  91.         } else if ( $1 == 1 ) {
  92.         ins_f_byte(F_CONST1); $$ = TYPE_NUMBER;
  93.         } else {
  94.         ins_f_byte(F_NUMBER); ins_long($1); $$ = TYPE_NUMBER;
  95.         }
  96.     } ;
  97.  
  98. optional_star: /* empty */ { $$ = 0; } | '*' { $$ = TYPE_MOD_POINTER; } ;
  99.  
  100. block_or_semi: block { $$ = 0; } | ';' { $$ = ';'; } ;
  101.  
  102. def: type optional_star F_IDENTIFIER
  103.     {
  104.         /* Save start of function. */
  105.         push_explicit(mem_block[A_PROGRAM].current_size);
  106.  
  107.         if ($1 & TYPE_MOD_MASK) {
  108.         exact_types = $1 | $2;
  109.         } else {
  110.         if (pragma_strict_types)
  111.             yyerror("\"#pragma strict_types\" requires type of function");
  112.         exact_types = 0;
  113.         }
  114.     }
  115.     '(' argument ')'
  116.     {
  117.         /*
  118.          * Define a prototype. If it is a real function, then the
  119.          * prototype will be replaced below.
  120.          */
  121.         define_new_function($3, $6, 0, 0,
  122.                 NAME_UNDEFINED|NAME_PROTOTYPE, $1 | $2);
  123.     }
  124.         block_or_semi
  125.     {
  126.         /* Either a prototype or a block */
  127.         if ($9 == ';') {
  128.         (void)pop_address(); /* Not used here */
  129.         } else {
  130.         define_new_function($3, $6, current_number_of_locals - $6+
  131.             ( max_break_stack_need -1 ) / sizeof(struct svalue) +1,
  132.             pop_address(), 0, $1 | $2);
  133.         ins_f_byte(F_CONST0); ins_f_byte(F_RETURN);
  134.         }
  135.         free_all_local_names();
  136.         free($3);        /* Value was copied above */
  137.     }
  138.    | type name_list ';' { if ($1 == 0) yyerror("Missing type"); }
  139.    | inheritance ;
  140.  
  141. new_arg_name: type optional_star F_IDENTIFIER
  142.     {
  143.         if (exact_types && $1 == 0) {
  144.         yyerror("Missing type for argument");
  145.         add_local_name($3, TYPE_ANY);    /* Supress more errors */
  146.         } else {
  147.         add_local_name($3, $1 | $2);
  148.         }
  149.     }
  150.       | type F_LOCAL_NAME
  151.         {yyerror("Illegal to redeclare local name"); } ;
  152.  
  153. argument: /* empty */ { $$ = 0; }
  154.       | argument_list ;
  155.  
  156. argument_list: new_arg_name { $$ = 1; }
  157.          | argument_list ',' new_arg_name { $$ = $1 + 1; } ;
  158.  
  159. type_modifier: F_NO_MASK { $$ = TYPE_MOD_NO_MASK; }
  160.          | F_STATIC { $$ = TYPE_MOD_STATIC; }
  161.          | F_PRIVATE { $$ = TYPE_MOD_PRIVATE; }
  162.          | F_PUBLIC { $$ = TYPE_MOD_PUBLIC; }
  163.          | F_VARARGS { $$ = TYPE_MOD_VARARGS; }
  164.          | F_PROTECTED { $$ = TYPE_MOD_PROTECTED; } ;
  165.  
  166. type_modifier_list: /* empty */ { $$ = 0; }
  167.           | type_modifier type_modifier_list { $$ = $1 | $2; } ;
  168.  
  169. type: type_modifier_list opt_basic_type { $$ = $1 | $2; current_type = $$; } ;
  170.  
  171. cast: '(' basic_type optional_star ')'
  172.     {
  173.         $$ = $2 | $3;
  174.     } ;
  175.  
  176. opt_basic_type: basic_type | /* empty */ { $$ = TYPE_UNKNOWN; } ;
  177.  
  178. basic_type: F_STATUS { $$ = TYPE_NUMBER; current_type = $$; }
  179.     | F_INT { $$ = TYPE_NUMBER; current_type = $$; }
  180.     | F_STRING_DECL { $$ = TYPE_STRING; current_type = $$; }
  181.     | F_OBJECT { $$ = TYPE_OBJECT; current_type = $$; }
  182.     | F_VOID {$$ = TYPE_VOID; current_type = $$; }
  183.     | F_MIXED { $$ = TYPE_ANY; current_type = $$; } ;
  184.  
  185. name_list: new_name
  186.      | new_name ',' name_list;
  187.  
  188. new_name: optional_star F_IDENTIFIER
  189.     {
  190.         define_variable($2, current_type | $1, 0);
  191.         free($2);
  192.     }
  193. | optional_star F_IDENTIFIER
  194.     {
  195.         int var_num;
  196.         define_variable($2, current_type | $1, 0);
  197.         var_num = verify_declared($2);
  198.         transfer_init_control();
  199.         ins_f_byte(F_PUSH_IDENTIFIER_LVALUE);
  200.         ins_byte(var_num);
  201.     }
  202.     '=' expr0
  203.     {
  204.         if (!compatible_types((current_type | $1) & TYPE_MOD_MASK, $5)){
  205.         char buff[100];
  206.         sprintf(buff, "Type mismatch %s when initializing %s",
  207.             get_two_types(current_type | $1, $5), $2);
  208.         yyerror(buff);
  209.         }
  210.         ins_f_byte(F_ASSIGN);
  211.         ins_f_byte(F_POP_VALUE);
  212.         add_new_init_jump();
  213.         free($2);
  214.     } ;
  215. block: '{' local_declarations statements '}'
  216.     { ; };
  217.  
  218. local_declarations: /* empty */
  219.           | local_declarations basic_type local_name_list ';' ;
  220.  
  221. new_local_name: optional_star F_IDENTIFIER
  222.     {
  223.         add_local_name($2, current_type | $1);
  224.     } ;
  225.  
  226. local_name_list: new_local_name
  227.     | new_local_name ',' local_name_list ;
  228.  
  229. statements: /* empty */
  230.       | statement statements
  231.       | error ';' ;
  232.  
  233. statement: comma_expr ';'
  234.     {
  235.         ins_f_byte(F_POP_VALUE);
  236.         if (d_flag)
  237.         ins_f_byte(F_BREAK_POINT);
  238.         /* if (exact_types && !TYPE($1,TYPE_VOID))
  239.         yyerror("Value thrown away"); */
  240.     }
  241.      | cond | while | do | for | switch | case | default | return ';'
  242.      | block
  243.        | /* empty */ ';'
  244.      | F_BREAK ';'    /* This code is a jump to a jump */
  245.         {
  246.             if (current_break_address == 0)
  247.             yyerror("break statement outside loop");
  248.             if (current_break_address & BREAK_ON_STACK) {
  249.             ins_f_byte(F_BREAK);
  250.             } else {
  251.                 ins_f_byte(F_JUMP); ins_short(current_break_address);
  252.             }
  253.         }
  254.      | F_CONTINUE ';'    /* This code is a jump to a jump */
  255.         {
  256.             if (current_continue_address == 0)
  257.             yyerror("continue statement outside loop");
  258.             ins_f_byte(F_JUMP); ins_short(current_continue_address);
  259.         }
  260.          ;
  261.  
  262. while:  {   push_explicit(current_continue_address);
  263.         push_explicit(current_break_address);
  264.         current_continue_address = mem_block[A_PROGRAM].current_size;
  265.     } F_WHILE '(' comma_expr ')'
  266.     {
  267.         ins_f_byte(F_JUMP_WHEN_NON_ZERO); ins_short(0);    /* to block */
  268.         current_break_address = mem_block[A_PROGRAM].current_size;
  269.         ins_f_byte(F_JUMP); ins_short(0);    /* Exit loop */
  270.         upd_short(current_break_address-2,
  271.               mem_block[A_PROGRAM].current_size);
  272.     }
  273.        statement
  274.     {
  275.       ins_f_byte(F_JUMP); ins_short(current_continue_address);
  276.       upd_short(current_break_address+1,
  277.             mem_block[A_PROGRAM].current_size);
  278.       current_break_address = pop_address();
  279.       current_continue_address = pop_address();
  280.         }
  281.  
  282. do: {
  283.         int tmp_save;
  284.         push_explicit(current_continue_address);
  285.     push_explicit(current_break_address);
  286.     /* Jump to start of loop. */
  287.     ins_f_byte(F_JUMP); tmp_save = mem_block[A_PROGRAM].current_size;
  288.     ins_short(0);
  289.     current_break_address = mem_block[A_PROGRAM].current_size;
  290.     /* Jump to end of loop. All breaks go through this one. */
  291.     ins_f_byte(F_JUMP); push_address(); ins_short(0);
  292.     current_continue_address = mem_block[A_PROGRAM].current_size;
  293.     upd_short(tmp_save, current_continue_address);
  294.         push_address();
  295.     
  296.     } F_DO statement F_WHILE '(' comma_expr ')' ';'
  297.     {
  298.     ins_f_byte(F_JUMP_WHEN_NON_ZERO); ins_short(pop_address());
  299.     /* Fill in the break jump address in the beginning of the loop. */
  300.     upd_short(pop_address(), mem_block[A_PROGRAM].current_size);
  301.     current_break_address = pop_address();
  302.     current_continue_address = pop_address();
  303.     }
  304.  
  305. for: F_FOR '('      { push_explicit(current_continue_address);
  306.             push_explicit(current_break_address); }
  307.      for_expr ';' {   ins_f_byte(F_POP_VALUE);
  308.               push_address();
  309.           }
  310.      for_expr ';' {
  311.             ins_f_byte(F_JUMP_WHEN_NON_ZERO);
  312.             ins_short(0);    /* Jump to block of block */
  313.             current_break_address = mem_block[A_PROGRAM].current_size;
  314.             ins_f_byte(F_JUMP); ins_short(0);    /* Out of loop */
  315.              current_continue_address =
  316.             mem_block[A_PROGRAM].current_size;
  317.           }
  318.      for_expr ')' {
  319.              ins_f_byte(F_POP_VALUE);
  320.             ins_f_byte(F_JUMP); ins_short(pop_address());
  321.             /* Here starts the block. */
  322.             upd_short(current_break_address-2,
  323.                   mem_block[A_PROGRAM].current_size);
  324.           }
  325.      statement
  326.    {
  327.        ins_f_byte(F_JUMP); ins_short(current_continue_address);
  328.        /* Now, the address of the end of the block is known. */
  329.        upd_short(current_break_address+1, mem_block[A_PROGRAM].current_size);
  330.        current_break_address = pop_address();
  331.        current_continue_address = pop_address();
  332.    }
  333.  
  334. for_expr: /* EMPTY */ { ins_f_byte(F_CONST1); }
  335.         | comma_expr;
  336.  
  337. switch: F_SWITCH '(' comma_expr ')'
  338.     {
  339.         current_break_stack_need += sizeof(short);
  340.         if ( current_break_stack_need > max_break_stack_need )
  341.             max_break_stack_need = current_break_stack_need;
  342.     push_explicit(current_case_number_heap);
  343.     push_explicit(current_case_string_heap);
  344.     push_explicit(zero_case_label);
  345.     push_explicit(current_break_address);
  346.     ins_f_byte(F_SWITCH);
  347.     ins_byte(0xff); /* kind of table */
  348.     current_case_number_heap = mem_block[A_CASE_NUMBERS].current_size;
  349.     current_case_string_heap = mem_block[A_CASE_STRINGS].current_size;
  350.     zero_case_label = NO_STRING_CASE_LABELS;
  351.     ins_short(0); /* address of table */
  352.     current_break_address = mem_block[A_PROGRAM].current_size |
  353.                 BREAK_ON_STACK | BREAK_FROM_CASE ;
  354.     ins_short(0); /* break address to push, table is entered before */
  355.     ins_short(0); /* default address */
  356.     }
  357.       statement
  358.     {
  359.     char *heap_start;
  360.     int heap_end_offs;
  361.     int i,o;
  362.     int current_key,last_key;
  363.     /* int size_without_table; */
  364.     int block_index;
  365.     int current_case_heap;
  366.     int lookup_start;
  367.     int lookup_start_key;
  368.  
  369.     current_break_address &= ~(BREAK_ON_STACK|BREAK_FROM_CASE);
  370.  
  371.     if ( !read_short(current_break_address+2 ) )
  372.         upd_short(current_break_address+2,     /* no default given ->  */
  373.           mem_block[A_PROGRAM].current_size);  /* create one           */
  374.  
  375.     /* it isn't unusual that the last case/default has no break */
  376.     ins_f_byte(F_BREAK);
  377.     if(zero_case_label & (NO_STRING_CASE_LABELS|SOME_NUMERIC_CASE_LABELS)){
  378.         block_index = A_CASE_NUMBERS;
  379.         current_case_heap = current_case_number_heap;
  380.     } else {
  381.         block_index = A_CASE_STRINGS;
  382.         current_case_heap = current_case_string_heap;
  383.         if (zero_case_label&0xffff) {
  384.         struct case_heap_entry temp;
  385.  
  386.         temp.key = ZERO_AS_STR_CASE_LABEL;
  387.         temp.addr = zero_case_label;
  388.         temp.line = 0; /* if this is accessed later, something is
  389.                 * really wrong                  */
  390.         add_to_case_heap(A_CASE_STRINGS,&temp);
  391.         }
  392.     }
  393.     heap_start = mem_block[block_index].block + current_case_heap ;
  394.     heap_end_offs = mem_block[block_index].current_size -current_case_heap;
  395.     if (!heap_end_offs) yyerror("switch without case not supported");
  396.  
  397.         /* add a dummy entry so that we can always
  398.         * assume we have no or two childs
  399.         */
  400.         add_to_mem_block(block_index, "\0\0\0\0\0\0\0\0",
  401.             sizeof(struct case_heap_entry) );
  402.  
  403.         /* read out the heap and build a sorted table */
  404.     /* the table could be optimized better, but let's first see
  405.     * how much switch is used at all when it is full-featured...
  406.     */
  407.     mem_block[A_CASE_LABELS].current_size = 0;
  408.     lookup_start = 0;
  409.     lookup_start_key = ((struct case_heap_entry*)heap_start)->key;
  410.         for( ; ((struct case_heap_entry*)heap_start)->addr; )
  411.         {
  412.             int offset;
  413.         int curr_line,last_line;
  414.         unsigned short current_addr,last_addr = 0xffff;
  415.         int range_start;
  416.  
  417.             current_key = ((struct case_heap_entry*)heap_start)->key ;
  418.             curr_line = ((struct case_heap_entry*)heap_start)->line ;
  419.             current_addr = ((struct case_heap_entry*)heap_start)->addr ;
  420.             if ( current_key == last_key &&
  421.               mem_block[A_CASE_LABELS].current_size )
  422.             {
  423.                 char buf[90];
  424.  
  425.                 sprintf(buf,"Duplicate case in line %d and %d",
  426.             last_line, curr_line);
  427.                 yyerror(buf);
  428.             }
  429.         if (curr_line) {
  430.         if (last_addr == 1) {
  431.                     char buf[120];
  432.     
  433.             sprintf(buf,
  434. "Discontinued case label list range, line %d by line %d",
  435.               last_line, curr_line);
  436.                     yyerror(buf);
  437.         }
  438.           else if (current_key == last_key + 1
  439.             && current_addr == last_addr) {
  440.             if (mem_block[A_CASE_LABELS].current_size
  441.               != range_start + 6) {
  442.               *(short*)(mem_block[A_CASE_LABELS].block+range_start+4)
  443.             =1;
  444.               mem_block[A_CASE_LABELS].current_size = range_start + 6;
  445.             }
  446.         } else {
  447.             range_start = mem_block[A_CASE_LABELS].current_size;
  448.         }
  449.         }
  450.             last_key = current_key;
  451.         last_line = curr_line;
  452.         last_addr = current_addr;
  453.         add_to_mem_block(A_CASE_LABELS,
  454.                 (char *)¤t_key, sizeof(long) );
  455.         add_to_mem_block(A_CASE_LABELS,
  456.         (char *)¤t_addr, sizeof(short) );
  457.             for ( offset = 0; ; )
  458.             {
  459.  
  460.                 int child1,child2;
  461.  
  462.                 child1 = ( offset << 1 ) + sizeof(struct case_heap_entry);
  463.                 child2 = child1 + sizeof(struct case_heap_entry);
  464.                 if ( child1 >= heap_end_offs ) break;
  465.                 if ( ((struct case_heap_entry*)(heap_start+child1))->addr &&
  466.                   ( !((struct case_heap_entry*)(heap_start+child2))->addr ||
  467.                    ((struct case_heap_entry*)(heap_start+child1))->key <=
  468.                    ((struct case_heap_entry*)(heap_start+child2))->key  ) )
  469.                 {
  470.                     *(struct case_heap_entry*)(heap_start+offset) =
  471.                     *(struct case_heap_entry*)(heap_start+child1);
  472.                     offset = child1;
  473.                 } else
  474.                     if (((struct case_heap_entry*)(heap_start+child2))->addr ) {
  475.                         *(struct case_heap_entry*)(heap_start+offset) =
  476.                         *(struct case_heap_entry*)(heap_start+child2);
  477.                         offset = child2;
  478.                     } else break;
  479.             }
  480.             ((struct case_heap_entry*)(heap_start+offset))->addr = 0;
  481.         }
  482.  
  483.     /* write start of table */
  484.         upd_short(current_break_address-2,
  485.             mem_block[A_PROGRAM].current_size);
  486.  
  487.     add_to_mem_block(A_PROGRAM, mem_block[A_CASE_LABELS].block,
  488.             mem_block[A_CASE_LABELS].current_size );
  489.         /* calculate starting index for itarative search at execution time */
  490.         for(i=0xf0,o=6; o<<1 <= mem_block[A_CASE_LABELS].current_size; )
  491.             i++,o<<=1;
  492.         if (block_index == A_CASE_STRINGS) i = ( i << 4 ) | 0xf;
  493.         /* and store it */
  494.         mem_block[A_PROGRAM].block[current_break_address-3] &= i;
  495. #if 0  /* neither the code for ordinary switch is fully debugged now,
  496.     * nor is the code for packed switch tables complete */
  497.     d = ((struct case_heap_entry*)heap_start)->key;
  498.     if ( (r-d)*sizeof(short) < heap_end_offs ) {
  499.         mem_block[A_PROGRAM].block[current_break_address-3] &= 0xfe;
  500.             upd_short(current_break_address-2, mem_block[A_PROGRAM].current_size);
  501.             size_without_table = mem_block[A_PROGRAM].current_size;
  502.         r = heap_end_offs / sizeof(struct case_heap_entry);
  503.         add_to_mem_block(A_PROGRAM,mem_block[A_PROGRAM]->block,
  504.         r * sizeof(short) );
  505.         memset(mem_block[A_PROGRAM]->block+size_without_table,
  506.         '\0',r * sizeof(short) );
  507.         ins_long( d );
  508.         for(; --r; heap_start += sizeof(struct case_heap_entry) )
  509.         {
  510.         upd_short(size_without_table + sizeof(short)*
  511.                     ( ((struct case_heap_entry*)heap_start)->key - d )
  512.           , ((struct case_heap_entry*)heap_start)->addr );
  513.         }
  514.         }
  515. #endif /* 0 */
  516.     upd_short(current_break_address, mem_block[A_PROGRAM].current_size);
  517.     
  518.     mem_block[A_CASE_NUMBERS].current_size = current_case_number_heap;
  519.     mem_block[A_CASE_STRINGS].current_size = current_case_string_heap;
  520.         current_break_address = pop_address();
  521.     zero_case_label = pop_address();
  522.         current_case_string_heap = pop_address();
  523.         current_case_number_heap = pop_address();
  524.         current_break_stack_need -= sizeof(short);
  525.     } ;
  526.  
  527. case: F_CASE case_label ':'
  528.     {
  529.     struct case_heap_entry temp;
  530.  
  531.     if ( !( current_break_address & BREAK_FROM_CASE ) ) {
  532.         yyerror("Case outside switch");
  533.         break;
  534.     }
  535.     temp.key = $2.key;
  536.     temp.addr = mem_block[A_PROGRAM].current_size;
  537.     temp.line = current_line;
  538.     add_to_case_heap($2.block,&temp);
  539.     }
  540.     | F_CASE case_label F_RANGE case_label ':'
  541.     {
  542.     struct case_heap_entry temp;
  543.  
  544.     if ( $2.block != A_CASE_NUMBERS || $4.block != A_CASE_NUMBERS )
  545.         yyerror("String case labels not allowed as range bounds");
  546.     if ($2.key > $4.key) break;
  547.     temp.key = $2.key;
  548.     temp.addr = 1;
  549.     temp.line = current_line;
  550.     add_to_case_heap(A_CASE_NUMBERS,&temp);
  551.     temp.key = $4.key;
  552.     temp.addr = mem_block[A_PROGRAM].current_size;
  553.     temp.line = 0;
  554.     add_to_case_heap(A_CASE_NUMBERS,&temp);
  555.     } ;
  556.     
  557. case_label: constant
  558.         {
  559.         if ( !(zero_case_label & NO_STRING_CASE_LABELS) )
  560.         yyerror("Mixed case label list not allowed");
  561.         if ( $$.key = $1 )
  562.             zero_case_label |= SOME_NUMERIC_CASE_LABELS;
  563.         else
  564.         zero_case_label |= mem_block[A_PROGRAM].current_size;
  565.         $$.block = A_CASE_NUMBERS;
  566.     }
  567.       | string_constant
  568.         {
  569.         if ( zero_case_label & SOME_NUMERIC_CASE_LABELS )
  570.         yyerror("Mixed case label list not allowed");
  571.         zero_case_label &= ~NO_STRING_CASE_LABELS;
  572.             store_prog_string($1);
  573.             $$.key = (int)$1;
  574.         $$.block = A_CASE_STRINGS;
  575.         }
  576.       ;
  577.  
  578. constant: const1
  579.     | constant '|' const1 { $$ = $1 | $3; } ;
  580.  
  581. const1: const2
  582.       | const1 '^' const2 { $$ = $1 ^ $3; } ;
  583.  
  584. const2: const3
  585.       | const2 '&' const3 { $$ = $1 & $3; } ;
  586.  
  587. const3: const4
  588.       | const3 F_EQ const4 { $$ = $1 == $3; }
  589.       | const3 F_NE const4 { $$ = $1 != $3; } ;
  590.  
  591. const4: const5
  592.       | const4 '>'  const5 { $$ = $1 >  $3; }
  593.       | const4 F_GE const5 { $$ = $1 >= $3; }
  594.       | const4 '<'  const5 { $$ = $1 <  $3; }
  595.       | const4 F_LE const5 { $$ = $1 <= $3; } ;
  596.  
  597. const5: const6
  598.       | const5 F_LSH const6 { $$ = $1 << $3; }
  599.       | const5 F_RSH const6 { $$ = $1 >> $3; } ;
  600.  
  601. const6: const7
  602.       | const6 '+' const7 { $$ = $1 + $3; }
  603.       | const6 '-' const7 { $$ = $1 - $3; } ;
  604.  
  605. const7: const8
  606.       | const7 '*' const8 { $$ = $1 * $3; }
  607.       | const7 '%' const8 { $$ = $1 % $3; }
  608.       | const7 '/' const8 { $$ = $1 / $3; } ;
  609.  
  610. const8: const9
  611.       | '(' constant ')' { $$ = $2; } ;
  612.  
  613. const9: F_NUMBER
  614.       | '-'   F_NUMBER { $$ = -$2; }
  615.       | F_NOT F_NUMBER { $$ = !$2; }
  616.       | '~'   F_NUMBER { $$ = ~$2; } ;
  617.  
  618. default: F_DEFAULT ':'
  619.     {
  620.     if ( !( current_break_address & BREAK_FROM_CASE ) ) {
  621.         yyerror("Default outside switch");
  622.         break;
  623.     }
  624.     current_break_address &= ~(BREAK_ON_STACK|BREAK_FROM_CASE);
  625.     if ( read_short(current_break_address+2 ) )
  626.         yyerror("Duplicate default");
  627.     upd_short(current_break_address+2, mem_block[A_PROGRAM].current_size);
  628.     current_break_address |= (BREAK_ON_STACK|BREAK_FROM_CASE);
  629.     } ;
  630.  
  631.  
  632. comma_expr: expr0 { $$ = $1; }
  633.           | comma_expr { ins_f_byte(F_POP_VALUE); }
  634.     ',' expr0
  635.     { $$ = $4; } ;
  636.  
  637. expr0:  expr01
  638.      | lvalue assign expr0
  639.     {
  640.         if (exact_types && !compatible_types($1, $3) &&
  641.         !($1 == TYPE_STRING && $3 == TYPE_NUMBER && $2 == F_ADD_EQ))
  642.         {
  643.         type_error("Bad assignment. Rhs", $3);
  644.         }
  645.         ins_f_byte($2);
  646.         $$ = $3;
  647.     }
  648.      | error assign expr01 { yyerror("Illegal LHS");  $$ = TYPE_ANY; };
  649.  
  650. expr01: expr1 { $$ = $1; }
  651.      | expr1 '?'
  652.     {
  653.         ins_f_byte(F_JUMP_WHEN_ZERO);
  654.         push_address();
  655.         ins_short(0);
  656.     }
  657.       expr01
  658.     {
  659.         int i;
  660.         i = pop_address();
  661.         ins_f_byte(F_JUMP); push_address(); ins_short(0);
  662.         upd_short(i, mem_block[A_PROGRAM].current_size);
  663.     }
  664.       ':' expr01
  665.     {
  666.         upd_short(pop_address(), mem_block[A_PROGRAM].current_size);
  667.         if (exact_types && !compatible_types($4, $7)) {
  668.         type_error("Different types in ?: expr", $4);
  669.         type_error("                      and ", $7);
  670.         }
  671.         if ($4 == TYPE_ANY) $$ = $7;
  672.         else if ($7 == TYPE_ANY) $$ = $4;
  673.         else if (TYPE($4, TYPE_MOD_POINTER|TYPE_ANY)) $$ = $7;
  674.         else if (TYPE($7, TYPE_MOD_POINTER|TYPE_ANY)) $$ = $4;
  675.         else $$ = $4;
  676.     };
  677.  
  678. assign: '=' { $$ = F_ASSIGN; }
  679.       | F_AND_EQ { $$ = F_AND_EQ; }
  680.       | F_OR_EQ { $$ = F_OR_EQ; }
  681.       | F_XOR_EQ { $$ = F_XOR_EQ; }
  682.       | F_LSH_EQ { $$ = F_LSH_EQ; }
  683.       | F_RSH_EQ { $$ = F_RSH_EQ; }
  684.       | F_ADD_EQ { $$ = F_ADD_EQ; }
  685.       | F_SUB_EQ { $$ = F_SUB_EQ; }
  686.       | F_MULT_EQ { $$ = F_MULT_EQ; }
  687.       | F_MOD_EQ { $$ = F_MOD_EQ; }
  688.       | F_DIV_EQ { $$ = F_DIV_EQ; };
  689.  
  690. return: F_RETURN
  691.     {
  692.         if (exact_types && !TYPE(exact_types, TYPE_VOID))
  693.         type_error("Must return a value for a function declared",
  694.                exact_types);
  695.         ins_f_byte(F_CONST0);
  696.         ins_f_byte(F_RETURN);
  697.     }
  698.       | F_RETURN comma_expr
  699.     {
  700.         if (exact_types && !TYPE($2, exact_types & TYPE_MOD_MASK))
  701.         type_error("Return type not matching", exact_types);
  702.         ins_f_byte(F_RETURN);
  703.     };
  704.  
  705. expr_list: /* empty */        { $$ = 0; }
  706.      | expr_list2        { $$ = $1; }
  707.      | expr_list2 ','    { $$ = $1; } ; /* Allow a terminating comma */
  708.  
  709. expr_list2: expr0        { $$ = 1; add_arg_type($1); }
  710.          | expr_list2 ',' expr0    { $$ = $1 + 1; add_arg_type($3); } ;
  711.  
  712. expr1: expr2 { $$ = $1; }
  713.      | expr2 F_LOR
  714.     {
  715.         ins_f_byte(F_DUP); ins_f_byte(F_JUMP_WHEN_NON_ZERO);
  716.         push_address();
  717.         ins_short(0);
  718.         ins_f_byte(F_POP_VALUE);
  719.     }
  720.        expr1
  721.     {
  722.         upd_short(pop_address(), mem_block[A_PROGRAM].current_size);
  723.         if ($1 == $4)
  724.         $$ = $1;
  725.         else
  726.         $$ = TYPE_ANY;    /* Return type can't be known */
  727.     };
  728.  
  729. expr2: expr211 { $$ = $1; }
  730.      | expr211 F_LAND
  731.     {
  732.         ins_f_byte(F_DUP); ins_f_byte(F_JUMP_WHEN_ZERO);
  733.         push_address();
  734.         ins_short(0);
  735.         ins_f_byte(F_POP_VALUE);
  736.     }
  737.        expr2
  738.     {
  739.         upd_short(pop_address(), mem_block[A_PROGRAM].current_size);
  740.         if ($1 == $4)
  741.         $$ = $1;
  742.         else
  743.         $$ = TYPE_ANY;    /* Return type can't be known */
  744.     } ;
  745.  
  746. expr211: expr212
  747.        | expr211 '|' expr212
  748.           {
  749.           if (exact_types && !TYPE($1,TYPE_NUMBER))
  750.           type_error("Bad argument 1 to |", $1);
  751.           if (exact_types && !TYPE($3,TYPE_NUMBER))
  752.           type_error("Bad argument 2 to |", $3);
  753.           $$ = TYPE_NUMBER;
  754.           ins_f_byte(F_OR);
  755.       };
  756.  
  757. expr212: expr213
  758.        | expr212 '^' expr213
  759.       {
  760.           if (exact_types && !TYPE($1,TYPE_NUMBER))
  761.           type_error("Bad argument 1 to ^", $1);
  762.           if (exact_types && !TYPE($3,TYPE_NUMBER))
  763.           type_error("Bad argument 2 to ^", $3);
  764.           $$ = TYPE_NUMBER;
  765.           ins_f_byte(F_XOR);
  766.       };
  767.  
  768. expr213: expr22
  769.        | expr213 '&' expr22
  770.       {
  771.           ins_f_byte(F_AND);
  772.           if ( !TYPE($1,TYPE_MOD_POINTER) || !TYPE($3,TYPE_MOD_POINTER) ) {
  773.               if (exact_types && !TYPE($1,TYPE_NUMBER))
  774.               type_error("Bad argument 1 to &", $1);
  775.               if (exact_types && !TYPE($3,TYPE_NUMBER))
  776.               type_error("Bad argument 2 to &", $3);
  777.           }
  778.           $$ = TYPE_NUMBER;
  779.       };
  780.  
  781. expr22: expr23
  782.       | expr24 F_EQ expr24
  783.     {
  784.         int t1 = $1 & TYPE_MOD_MASK, t2 = $3 & TYPE_MOD_MASK;
  785.         if (exact_types && t1 != t2 && t1 != TYPE_ANY && t2 != TYPE_ANY) {
  786.         type_error("== always false because of different types", $1);
  787.         type_error("                               compared to", $3);
  788.         }
  789.         ins_f_byte(F_EQ);
  790.         $$ = TYPE_NUMBER;
  791.     };
  792.       | expr24 F_NE expr24
  793.     {
  794.         int t1 = $1 & TYPE_MOD_MASK, t2 = $3 & TYPE_MOD_MASK;
  795.         if (exact_types && t1 != t2 && t1 != TYPE_ANY && t2 != TYPE_ANY) {
  796.         type_error("!= always true because of different types", $1);
  797.         type_error("                               compared to", $3);
  798.         }
  799.         ins_f_byte(F_NE);
  800.         $$ = TYPE_NUMBER;
  801.     };
  802.  
  803. expr23: expr24
  804.       | expr24 '>' expr24
  805.     { $$ = TYPE_NUMBER; ins_f_byte(F_GT); };
  806.       | expr24 F_GE expr24
  807.     { $$ = TYPE_NUMBER; ins_f_byte(F_GE); };
  808.       | expr24 '<' expr24
  809.     { $$ = TYPE_NUMBER; ins_f_byte(F_LT); };
  810.       | expr24 F_LE expr24
  811.     { $$ = TYPE_NUMBER; ins_f_byte(F_LE); };
  812.  
  813. expr24: expr25
  814.       | expr24 F_LSH expr25
  815.     {
  816.         ins_f_byte(F_LSH);
  817.         $$ = TYPE_NUMBER;
  818.         if (exact_types && !TYPE($1, TYPE_NUMBER))
  819.         type_error("Bad argument number 1 to '<<'", $1);
  820.         if (exact_types && !TYPE($3, TYPE_NUMBER))
  821.         type_error("Bad argument number 2 to '<<'", $3);
  822.     };
  823.       | expr24 F_RSH expr25
  824.     {
  825.         ins_f_byte(F_RSH);
  826.         $$ = TYPE_NUMBER;
  827.         if (exact_types && !TYPE($1, TYPE_NUMBER))
  828.         type_error("Bad argument number 1 to '>>'", $1);
  829.         if (exact_types && !TYPE($3, TYPE_NUMBER))
  830.         type_error("Bad argument number 2 to '>>'", $3);
  831.     };
  832.  
  833. expr25: expr27
  834.       | expr25 '+' expr27    /* Type checks of this case is complicated */
  835.     { ins_f_byte(F_ADD); $$ = TYPE_ANY; };
  836.       | expr25 '-' expr27
  837.     {
  838.         int bad_arg = 0;
  839.  
  840.         if (exact_types) {
  841.         if (!TYPE($1, TYPE_NUMBER) && !($1 & TYPE_MOD_POINTER) ) {
  842.                     type_error("Bad argument number 1 to '-'", $1);
  843.             bad_arg++;
  844.         }
  845.         if (!TYPE($3, TYPE_NUMBER) && !($3 & TYPE_MOD_POINTER) ) {
  846.                     type_error("Bad argument number 2 to '-'", $3);
  847.             bad_arg++;
  848.         }
  849.         }
  850.         $$ = TYPE_ANY;
  851.         if (($1 & TYPE_MOD_POINTER) || ($3 & TYPE_MOD_POINTER))
  852.         $$ = TYPE_MOD_POINTER | TYPE_ANY;
  853.         if (!($1 & TYPE_MOD_POINTER) || !($3 & TYPE_MOD_POINTER)) {
  854.         if (exact_types && $$ != TYPE_ANY && !bad_arg)
  855.             yyerror("Arguments to '-' don't match");
  856.         $$ = TYPE_NUMBER;
  857.         }
  858.         ins_f_byte(F_SUBTRACT);
  859.     };
  860.  
  861. expr27: expr28
  862.       | expr27 '*' expr3
  863.     {
  864.         if (exact_types && !TYPE($1, TYPE_NUMBER))
  865.         type_error("Bad argument number 1 to '*'", $1);
  866.         if (exact_types && !TYPE($3, TYPE_NUMBER))
  867.         type_error("Bad argument number 2 to '*'", $3);
  868.         ins_f_byte(F_MULTIPLY);
  869.         $$ = TYPE_NUMBER;
  870.     };
  871.       | expr27 '%' expr3
  872.     {
  873.         if (exact_types && !TYPE($1, TYPE_NUMBER))
  874.         type_error("Bad argument number 1 to '%'", $1);
  875.         if (exact_types && !TYPE($3, TYPE_NUMBER))
  876.         type_error("Bad argument number 2 to '%'", $3);
  877.         ins_f_byte(F_MOD);
  878.         $$ = TYPE_NUMBER;
  879.     };
  880.       | expr27 '/' expr3
  881.     {
  882.         if (exact_types && !TYPE($1, TYPE_NUMBER))
  883.         type_error("Bad argument number 1 to '/'", $1);
  884.         if (exact_types && !TYPE($3, TYPE_NUMBER))
  885.         type_error("Bad argument number 2 to '/'", $3);
  886.         ins_f_byte(F_DIVIDE);
  887.         $$ = TYPE_NUMBER;
  888.     };
  889.  
  890. expr28: expr3
  891.     | cast expr3
  892.           {
  893.           $$ = $1;
  894.           if (exact_types && $2 != TYPE_ANY && $2 != TYPE_UNKNOWN &&
  895.               $1 != TYPE_VOID)
  896.               type_error("Casts are only legal for type mixed, or when unknown", $2);
  897.           } ;
  898.  
  899. expr3: expr31
  900.      | F_INC lvalue
  901.         {
  902.         ins_f_byte(F_INC);
  903.         if (exact_types && !TYPE($2, TYPE_NUMBER))
  904.         type_error("Bad argument to ++", $2);
  905.         $$ = TYPE_NUMBER;
  906.     };
  907.      | F_DEC lvalue
  908.         {
  909.         ins_f_byte(F_DEC);
  910.         if (exact_types && !TYPE($2, TYPE_NUMBER))
  911.         type_error("Bad argument to --", $2);
  912.         $$ = TYPE_NUMBER;
  913.     };
  914.      | F_NOT expr3
  915.     {
  916.         ins_f_byte(F_NOT);    /* Any type is valid here. */
  917.         $$ = TYPE_NUMBER;
  918.     };
  919.      | '~' expr3
  920.     {
  921.         ins_f_byte(F_COMPL);
  922.         if (exact_types && !TYPE($2, TYPE_NUMBER))
  923.         type_error("Bad argument to ~", $2);
  924.         $$ = TYPE_NUMBER;
  925.     };
  926.      | '-' expr3
  927.     {
  928.         ins_f_byte(F_NEGATE);
  929.         if (exact_types && !TYPE($2, TYPE_NUMBER))
  930.         type_error("Bad argument to unary '-'", $2);
  931.         $$ = TYPE_NUMBER;
  932.     };
  933.  
  934. expr31: expr4
  935.       | lvalue F_INC
  936.          {
  937.          ins_f_byte(F_POST_INC);
  938.          if (exact_types && !TYPE($1, TYPE_NUMBER))
  939.          type_error("Bad argument to ++", $1);
  940.          $$ = TYPE_NUMBER;
  941.      };
  942.       | lvalue F_DEC
  943.          {
  944.          ins_f_byte(F_POST_DEC);
  945.          if (exact_types && !TYPE($1, TYPE_NUMBER))
  946.          type_error("Bad argument to --", $1);
  947.          $$ = TYPE_NUMBER;
  948.      };
  949.  
  950. expr4: function_call
  951.      | lvalue
  952.     {
  953.         int pos = mem_block[A_PROGRAM].current_size;
  954.         /* Some optimization. Replace the push-lvalue with push-value */
  955.         if (last_push_identifier == pos-2)
  956.         mem_block[A_PROGRAM].block[last_push_identifier] =
  957.             F_IDENTIFIER - F_OFFSET;
  958.         else if (last_push_local == pos-2)
  959.         mem_block[A_PROGRAM].block[last_push_local] =
  960.             F_LOCAL_NAME - F_OFFSET;
  961.         else if (last_push_indexed == pos-1)
  962.         mem_block[A_PROGRAM].block[last_push_indexed] =
  963.             F_INDEX - F_OFFSET;
  964.         else if (last_push_indexed != 0)
  965.         fatal("Should be a push at this point !\n");
  966.         $$ = $1;
  967.     }
  968.      | string | number
  969.      | '(' comma_expr ')' { $$ = $2; }
  970.      | catch { $$ = TYPE_ANY; }
  971.      | sscanf { $$ = TYPE_NUMBER; }
  972.      | parse_command { $$ = TYPE_NUMBER; }
  973.      | '(' '{' expr_list '}' ')'
  974.        {
  975.        pop_arg_stack($3);        /* We don't care about these types */
  976.        ins_f_byte(F_AGGREGATE);
  977.        ins_short($3);
  978.        $$ = TYPE_MOD_POINTER | TYPE_ANY;
  979.        };
  980.  
  981. catch: F_CATCH { ins_f_byte(F_CATCH); push_address(); ins_short(0);}
  982.        '(' comma_expr ')'
  983.            {
  984.            ins_f_byte(F_POP_VALUE);
  985. #if 1
  986.            ins_f_byte(F_CONST0);
  987.            ins_f_byte(F_THROW);
  988. #else
  989.            ins_f_byte(F_RETURN);
  990. #endif
  991.            upd_short(pop_address(),
  992.                  mem_block[A_PROGRAM].current_size);
  993.            };
  994.  
  995. sscanf: F_SSCANF '(' expr0 ',' expr0 lvalue_list ')'
  996.     {
  997.         ins_f_byte(F_SSCANF); ins_byte($6 + 2);
  998.     }
  999.  
  1000. parse_command: F_PARSE_COMMAND '(' expr0 ',' expr0 ',' expr0 lvalue_list ')'
  1001.     {
  1002.         ins_f_byte(F_PARSE_COMMAND); ins_byte($8 + 3);
  1003.     }
  1004.  
  1005. lvalue_list: /* empty */ { $$ = 0; }
  1006.        | ',' lvalue lvalue_list { $$ = 1 + $3; } ;
  1007.  
  1008. lvalue: F_IDENTIFIER
  1009.     {
  1010.         int i = verify_declared($1);
  1011.         last_push_identifier = mem_block[A_PROGRAM].current_size;
  1012.         ins_f_byte(F_PUSH_IDENTIFIER_LVALUE);
  1013.         ins_byte(i);
  1014.         free($1);
  1015.         if (i == -1)
  1016.         $$ = TYPE_ANY;
  1017.         else
  1018.         $$ = VARIABLE(i)->type & TYPE_MOD_MASK;
  1019.     }
  1020.         | F_LOCAL_NAME
  1021.     {
  1022.         last_push_local = mem_block[A_PROGRAM].current_size;
  1023.         ins_f_byte(F_PUSH_LOCAL_VARIABLE_LVALUE);
  1024.         ins_byte($1);
  1025.         $$ = type_of_locals[$1];
  1026.     }
  1027.     | expr4 '[' comma_expr F_RANGE comma_expr ']'
  1028.       {
  1029.           ins_f_byte(F_RANGE);
  1030.           last_push_indexed = 0;
  1031.           if (exact_types) {
  1032.           if (($1 & TYPE_MOD_POINTER) == 0 && !TYPE($1, TYPE_STRING))
  1033.               type_error("Bad type to indexed value", $1);
  1034.           if (!TYPE($3, TYPE_NUMBER))
  1035.               type_error("Bad type of index", $3);
  1036.           if (!TYPE($5, TYPE_NUMBER))
  1037.               type_error("Bad type of index", $5);
  1038.           }
  1039.           if ($1 == TYPE_ANY)
  1040.           $$ = TYPE_ANY;
  1041.           else if (TYPE($1, TYPE_STRING))
  1042.           $$ = TYPE_STRING;
  1043.           else if ($1 & TYPE_MOD_POINTER)
  1044.           $$ = $1;
  1045.           else if (exact_types)
  1046.           type_error("Bad type of argument used for range", $1);
  1047.       };
  1048.     | expr4 '[' comma_expr ']'
  1049.       {
  1050.           last_push_indexed = mem_block[A_PROGRAM].current_size;
  1051.           ins_f_byte(F_PUSH_INDEXED_LVALUE);
  1052.           if (exact_types) {
  1053.           if (($1 & TYPE_MOD_POINTER) == 0 && !TYPE($1, TYPE_STRING))
  1054.               type_error("Bad type to indexed value", $1);
  1055.           if (!TYPE($3, TYPE_NUMBER))
  1056.               type_error("Bad type of index", $3);
  1057.           }
  1058.           if ($1 == TYPE_ANY)
  1059.           $$ = TYPE_ANY;
  1060.           else if (TYPE($1, TYPE_STRING))
  1061.           $$ = TYPE_NUMBER;
  1062.           else
  1063.           $$ = $1 & TYPE_MOD_MASK & ~TYPE_MOD_POINTER;
  1064.       };
  1065.  
  1066. string: F_STRING
  1067.     {
  1068.         ins_f_byte(F_STRING);
  1069.         ins_short(store_prog_string($1));
  1070.         free($1);
  1071.         $$ = TYPE_STRING;
  1072.     };
  1073.  
  1074. string_constant: string_con1
  1075.         {
  1076.             char *p = make_shared_string($1);
  1077.             free($1);
  1078.             $$ = p;
  1079.         };
  1080.  
  1081. string_con1: F_STRING
  1082.        | string_con1 '+' F_STRING
  1083.     {
  1084.         $$ = xalloc( strlen($1) + strlen($3) + 1 );
  1085.         strcpy($$, $1);
  1086.         strcat($$, $3);
  1087.         free($1);
  1088.         free($3);
  1089.     };
  1090.  
  1091. function_call: function_name
  1092.     {
  1093.     /* This seems to be an ordinary function call. But, if the function
  1094.      * is not defined, then it might be a call to a simul_efun.
  1095.      * If it is, then we make it a call_other(), which requires the
  1096.      * function name as argument.
  1097.      * We have to remember until after parsing the arguments if it was
  1098.      * a simulated efun or not, which means that the pointer has to be
  1099.      * pushed on a stack. Use the internal yacc stack for this purpose.
  1100.      */
  1101.     $<funp>$ = 0;
  1102.     if (defined_function($1) == -1) {
  1103.         char *p = make_shared_string($1);
  1104.         $<funp>$ = find_simul_efun(p);
  1105.         if ($<funp>$ && !($<funp>$->type & TYPE_MOD_STATIC)) {
  1106.         ins_f_byte(F_STRING);
  1107.         ins_short(store_prog_string(
  1108.                   query_simul_efun_file_name()));
  1109.         ins_f_byte(F_STRING);
  1110.         ins_short(store_prog_string(p));
  1111.         } else {
  1112.         $<funp>$ = 0;
  1113.         }
  1114.         free_string(p);
  1115.     }
  1116.     }
  1117.     '(' expr_list ')'
  1118.     { 
  1119.     int f;
  1120.     int efun_override = strncmp($1, "efun::", 6) == 0;
  1121.  
  1122.     if ($<funp>2) {
  1123.         ins_f_byte(F_CALL_OTHER);
  1124.         ins_byte($4 + 2);
  1125.         $$ = $<funp>2->type;
  1126.     } else if (!efun_override && (f = defined_function($1)) >= 0) {
  1127.         struct function *funp;
  1128.         ins_f_byte(F_CALL_FUNCTION_BY_ADDRESS); ins_short(f);
  1129.         ins_byte($4);    /* Actual number of arguments */
  1130.         funp = FUNCTION(f);
  1131.         if (funp->flags & NAME_UNDEFINED)
  1132.         find_inherited(funp);
  1133.         /*
  1134.          * Verify that the function has been defined already.
  1135.          */
  1136.         if ((funp->flags & NAME_UNDEFINED) &&
  1137.         !(funp->flags & NAME_PROTOTYPE) && exact_types)
  1138.         {
  1139.         char buff[100];
  1140.         sprintf(buff, "Function %.50s undefined", funp->name);
  1141.         yyerror(buff);
  1142.         }
  1143.         $$ = funp->type & TYPE_MOD_MASK;
  1144.         /*
  1145.          * Check number of arguments.
  1146.          */
  1147.         if (funp->num_arg != $4 && !(funp->type & TYPE_MOD_VARARGS) &&
  1148.         (funp->flags & NAME_STRICT_TYPES) && exact_types)
  1149.         {
  1150.         char buff[100];
  1151.         sprintf(buff, "Wrong number of arguments to %.60s", $1);
  1152.         yyerror(buff);
  1153.         }
  1154.         /*
  1155.          * Check the argument types.
  1156.          */
  1157.         if (exact_types && *(unsigned short *)&mem_block[A_ARGUMENT_INDEX].block[f * sizeof (unsigned short)] != INDEX_START_NONE)
  1158.         {
  1159.         int i, first;
  1160.         unsigned short *arg_types;
  1161.         
  1162.         arg_types = (unsigned short *)
  1163.             mem_block[A_ARGUMENT_TYPES].block;
  1164.         first = *(unsigned short *)&mem_block[A_ARGUMENT_INDEX].block[f * sizeof (unsigned short)];
  1165.         for (i=0; i < funp->num_arg && i < $4; i++) {
  1166.             int tmp = get_argument_type(i, $4);
  1167.             if (!TYPE(tmp, arg_types[first + i])) {
  1168.             char buff[100];
  1169.             sprintf(buff, "Bad type for argument %d %s", i+1,
  1170.                 get_two_types(arg_types[first+i], tmp));
  1171.             yyerror(buff);
  1172.             }
  1173.         }
  1174.         }
  1175.     } else if (efun_override || (f = lookup_predef($1)) != -1) {
  1176.         int min, max, def, *argp;
  1177.         extern int efun_arg_types[];
  1178.  
  1179.         if (efun_override) {
  1180.         f = lookup_predef($1+6);
  1181.         }
  1182.         if (f == -1) {    /* Only possible for efun_override */
  1183.         char buff[100];
  1184.         sprintf(buff, "Unknown efun: %s", $1+6);
  1185.         yyerror(buff);
  1186.         } else {
  1187.         min = instrs[f-F_OFFSET].min_arg;
  1188.         max = instrs[f-F_OFFSET].max_arg;
  1189.         def = instrs[f-F_OFFSET].Default;
  1190.         $$ = instrs[f-F_OFFSET].ret_type;
  1191.         argp = &efun_arg_types[instrs[f-F_OFFSET].arg_index];
  1192.         if (def && $4 == min-1) {
  1193.             ins_f_byte(def);
  1194.             max--;
  1195.             min--;
  1196.         } else if ($4 < min) {
  1197.             char bff[100];
  1198.             sprintf(bff, "Too few arguments to %s",
  1199.                 instrs[f-F_OFFSET].name);
  1200.             yyerror(bff);
  1201.         } else if ($4 > max && max != -1) {
  1202.             char bff[100];
  1203.             sprintf(bff, "Too many arguments to %s",
  1204.                 instrs[f-F_OFFSET].name);
  1205.             yyerror(bff);
  1206.         } else if (max != -1 && exact_types) {
  1207.             /*
  1208.              * Now check all types of the arguments to efuns.
  1209.              */
  1210.             int i, argn;
  1211.             char buff[100];
  1212.             for (argn=0; argn < $4; argn++) {
  1213.             int tmp = get_argument_type(argn, $4);
  1214.             for(i=0; !TYPE(argp[i], tmp) && argp[i] != 0; i++)
  1215.                 ;
  1216.             if (argp[i] == 0) {
  1217.                 sprintf(buff, "Bad argument %d type to efun %s()",
  1218.                     argn+1, instrs[f-F_OFFSET].name);
  1219.                 yyerror(buff);
  1220.             }
  1221.             while(argp[i] != 0)
  1222.                 i++;
  1223.             argp += i + 1;
  1224.             }
  1225.         }
  1226.         ins_f_byte(f);
  1227.         /* Only store number of arguments for instructions
  1228.          * that allowed a variable number.
  1229.          */
  1230.         if (max != min)
  1231.             ins_byte($4);/* Number of actual arguments */
  1232.         }
  1233.     } else {
  1234.         struct function *funp;
  1235.  
  1236.         f = define_new_function($1, 0, 0, 0, NAME_UNDEFINED, 0);
  1237.         ins_f_byte(F_CALL_FUNCTION_BY_ADDRESS);
  1238.         ins_short(f);
  1239.         ins_byte($4);    /* Number of actual arguments */
  1240.         funp = FUNCTION(f);
  1241.         if (strchr($1, ':')) {
  1242.         /*
  1243.          * A function defined by inheritance. Find
  1244.          * real definition immediately.
  1245.          */
  1246.         find_inherited(funp);
  1247.         }
  1248.         /*
  1249.          * Check if this function has been defined.
  1250.          * But, don't complain yet about functions defined
  1251.          * by inheritance.
  1252.          */
  1253.         if (exact_types && (funp->flags & NAME_UNDEFINED)) {
  1254.         char buff[100];
  1255.         sprintf(buff, "Undefined function %.50s", $1);
  1256.         yyerror(buff);
  1257.         }
  1258.         if (!(funp->flags & NAME_UNDEFINED))
  1259.         $$ = funp->type;
  1260.         else
  1261.         $$ = TYPE_ANY;    /* Just a guess */
  1262.     }
  1263.     free($1);
  1264.     pop_arg_stack($4);    /* Argument types not needed more */
  1265.     }
  1266. | expr4 F_ARROW function_name
  1267.     {
  1268.     ins_f_byte(F_STRING);
  1269.     ins_short(store_prog_string($3));
  1270.     free($3);
  1271.     }
  1272. '(' expr_list ')'
  1273.     {
  1274.     ins_f_byte(F_CALL_OTHER);
  1275.     ins_byte($6 + 2);
  1276.     $$ = TYPE_UNKNOWN;
  1277.     pop_arg_stack($6);    /* No good need of these arguments */
  1278.     };
  1279.  
  1280. function_name: F_IDENTIFIER
  1281.          | F_COLON_COLON F_IDENTIFIER
  1282.         {
  1283.             char *p = xalloc(strlen($2) + 3);
  1284.             strcpy(p, "::"); strcat(p, $2); free($2);
  1285.             $$ = p;
  1286.         }
  1287.           | F_IDENTIFIER F_COLON_COLON F_IDENTIFIER
  1288.         {
  1289.             char *p = xalloc(strlen($1) + strlen($3) + 3);
  1290.             strcpy(p, $1); strcat(p, "::"); strcat(p, $3);
  1291.             free($1); free($3);
  1292.             $$ = p;
  1293.         };
  1294.  
  1295. cond: condStart
  1296.       statement
  1297.     {
  1298.         int i;
  1299.         i = pop_address();
  1300.         ins_f_byte(F_JUMP); push_address(); ins_short(0);
  1301.         upd_short(i, mem_block[A_PROGRAM].current_size);
  1302.     }
  1303.       optional_else_part
  1304.     { upd_short(pop_address(), mem_block[A_PROGRAM].current_size); } ;
  1305.  
  1306. condStart: F_IF '(' comma_expr ')'
  1307.     {
  1308.         ins_f_byte(F_JUMP_WHEN_ZERO);
  1309.         push_address();
  1310.         ins_short(0);
  1311.     } ;
  1312.  
  1313. optional_else_part: /* empty */
  1314.        | F_ELSE statement ;
  1315. %%
  1316.  
  1317. void yyerror(str)
  1318. char *str;
  1319. {
  1320.     extern int num_parse_error;
  1321.  
  1322.     if (num_parse_error > 5)
  1323.     return;
  1324.     (void)fprintf(stderr, "%s: %s line %d\n", current_file, str,
  1325.           current_line);
  1326.     fflush(stderr);
  1327.     smart_log(current_file, current_line, str);
  1328.     if (num_parse_error == 0)
  1329.     save_error(str, current_file, current_line);
  1330.     num_parse_error++;
  1331. }
  1332.  
  1333. static int check_declared(str)
  1334.     char *str;
  1335. {
  1336.     struct variable *vp;
  1337.     int offset;
  1338.  
  1339.     for (offset=0;
  1340.      offset < mem_block[A_VARIABLES].current_size;
  1341.      offset += sizeof (struct variable)) {
  1342.     vp = (struct variable *)&mem_block[A_VARIABLES].block[offset];
  1343.     if (vp->flags & NAME_HIDDEN)
  1344.         continue;
  1345.     if (strcmp(vp->name, str) == 0)
  1346.         return offset / sizeof (struct variable);
  1347.     }
  1348.     return -1;
  1349. }
  1350.  
  1351. static int verify_declared(str)
  1352.     char *str;
  1353. {
  1354.     int r;
  1355.  
  1356.     r = check_declared(str);
  1357.     if (r < 0) {
  1358.     char buff[100];
  1359.         (void)sprintf(buff, "Variable %s not declared !", str);
  1360.         yyerror(buff);
  1361.     return -1;
  1362.     }
  1363.     return r;
  1364. }
  1365.  
  1366. void free_all_local_names()
  1367. {
  1368.     int i;
  1369.  
  1370.     for (i=0; i<current_number_of_locals; i++) {
  1371.     free(local_names[i]);
  1372.     local_names[i] = 0;
  1373.     }
  1374.     current_number_of_locals = 0;
  1375.     current_break_stack_need = 0;
  1376.     max_break_stack_need = 0;
  1377. }
  1378.  
  1379. void add_local_name(str, type)
  1380.     char *str;
  1381.     int type;
  1382. {
  1383.     if (current_number_of_locals == MAX_LOCAL)
  1384.     yyerror("Too many local variables");
  1385.     else {
  1386.     type_of_locals[current_number_of_locals] = type;
  1387.     local_names[current_number_of_locals++] = str;
  1388.     }
  1389. }
  1390.  
  1391. /*
  1392.  * Copy all function definitions from an inherited object. They are added
  1393.  * as undefined, so that they can be redefined by a local definition.
  1394.  * If they are not redefined, then they will be updated, so that they
  1395.  * point to the inherited definition. See epilog(). Types will be copied
  1396.  * at that moment (if available).
  1397.  *
  1398.  * A call to an inherited function will not be
  1399.  * done through this entry (because this entry can be replaced by a new
  1400.  * definition). If an function defined by inheritance is called, then one
  1401.  * special definition will be made at first call.
  1402.  */
  1403. static int copy_functions(from, type)
  1404.     struct program *from;
  1405.     int type;
  1406. {
  1407.     int i, initializer = -1;
  1408.     unsigned short tmp_short;
  1409.  
  1410.     for (i=0; i < from->num_functions; i++) {
  1411.     /* Do not call define_new_function() from here, as duplicates would
  1412.      * be removed.
  1413.      */
  1414.     struct function fun;
  1415.     int new_type;
  1416.  
  1417.     fun = from->functions[i];    /* Make a copy */
  1418.     /* Prepare some data to be used if this function will not be
  1419.      * redefined.
  1420.      */
  1421.     if (strchr(fun.name, ':'))
  1422.         fun.flags |= NAME_HIDDEN;    /* Not to be used again ! */
  1423.     fun.name = make_shared_string(fun.name);    /* Incr ref count */
  1424.     fun.offset = mem_block[A_INHERITS].current_size /
  1425.         sizeof (struct inherit) - 1;
  1426.     fun.function_index_offset = i;
  1427.     if (fun.type & TYPE_MOD_NO_MASK) {
  1428.         int n;
  1429.         if ((n = defined_function(fun.name)) != -1 &&
  1430.         !(((struct function *)mem_block[A_FUNCTIONS].block)[n].flags &
  1431.           NAME_UNDEFINED))
  1432.         {
  1433.         char *p = (char *)alloca(80 + strlen(fun.name));
  1434.         sprintf(p, "Illegal to redefine 'nomask' function \"%s\"",
  1435.             fun.name);
  1436.         yyerror(p);
  1437.         }
  1438.         fun.flags |= NAME_INHERITED;
  1439.     } else if (!(fun.flags & NAME_HIDDEN)) {
  1440.         fun.flags |= NAME_UNDEFINED;
  1441.     }
  1442.     /*
  1443.      * public functions should not become private when inherited
  1444.      * 'private'
  1445.      */
  1446.     new_type = type;
  1447.     if (fun.type & TYPE_MOD_PUBLIC)
  1448.         new_type &= ~TYPE_MOD_PRIVATE;
  1449.     fun.type |= new_type;
  1450.     /* marion
  1451.      * this should make possible to inherit a heart beat function, and
  1452.      * thus to mask it if wanted.
  1453.      */
  1454.     if (heart_beat == -1 && fun.name[0] == 'h' &&
  1455.         strcmp(fun.name, "heart_beat") == 0)
  1456.     {
  1457.         heart_beat = mem_block[A_FUNCTIONS].current_size /
  1458.         sizeof (struct function);
  1459.     } else if (fun.name[0] == '_' && strcmp(fun.name, "__INIT") == 0) {
  1460.         initializer = i;
  1461.         fun.flags |= NAME_INHERITED;
  1462.     }
  1463.     add_to_mem_block(A_FUNCTIONS, (char *)&fun, sizeof fun);
  1464.     /*
  1465.      * Copy information about the types of the arguments, if it is
  1466.      * available.
  1467.      */
  1468.     tmp_short = INDEX_START_NONE;    /* Presume not available. */
  1469.     if (from->type_start != 0 && from->type_start[i] != INDEX_START_NONE)
  1470.     {
  1471.         int arg;
  1472.         /*
  1473.          * They are available for function number 'i'. Copy types of
  1474.          * all arguments, and remember where they started.
  1475.          */
  1476.         tmp_short = mem_block[A_ARGUMENT_TYPES].current_size /
  1477.         sizeof from->argument_types[0];
  1478.         for (arg = 0; arg < fun.num_arg; arg++) {
  1479.         add_to_mem_block(A_ARGUMENT_TYPES,
  1480.                  &from->argument_types[from->type_start[i]],
  1481.                  sizeof (unsigned short));
  1482.         }
  1483.     }
  1484.     /*
  1485.      * Save the index where they started. Every function will have an
  1486.      * index where the type info of arguments starts.
  1487.      */
  1488.     add_to_mem_block(A_ARGUMENT_INDEX, &tmp_short, sizeof tmp_short);
  1489.     }
  1490.     return initializer;
  1491. }
  1492.  
  1493. /*
  1494.  * Copy all variabel names from the object that is inherited from.
  1495.  * It is very important that they are stored in the same order with the
  1496.  * same index.
  1497.  */
  1498. static void copy_variables(from, type)
  1499.     struct program *from;
  1500.     int type;
  1501. {
  1502.     int i;
  1503.  
  1504.     for (i=0; i<from->num_variables; i++) {
  1505.     int new_type = type;
  1506.     int n = check_declared(from->variable_names[i].name);
  1507.  
  1508.     if (n != -1 && (VARIABLE(n)->type & TYPE_MOD_NO_MASK)) {
  1509.         char *p = (char *)alloca(80 +
  1510.                      strlen(from->variable_names[i].name));
  1511.         sprintf(p, "Illegal to redefine 'nomask' variable \"%s\"",
  1512.             VARIABLE(n)->name);
  1513.         yyerror(p);
  1514.     }
  1515.     /*
  1516.      * 'public' variables should not become private when inherited
  1517.      * 'private'.
  1518.      */
  1519.     if (from->variable_names[i].type & TYPE_MOD_PUBLIC)
  1520.         new_type &= ~TYPE_MOD_PRIVATE;
  1521.     define_variable(from->variable_names[i].name,
  1522.             from->variable_names[i].type | new_type,
  1523.             from->variable_names[i].type & TYPE_MOD_PRIVATE ?
  1524.                 NAME_HIDDEN : 0);
  1525.     }
  1526. }
  1527.  
  1528. /*
  1529.  * This function is called from lex.c for every new line read from the
  1530.  * "top" file (means not included files). Some new lines are missed,
  1531.  * as with #include statements, so it is compensated for.
  1532.  */
  1533. void store_line_number_info()
  1534. {
  1535.     unsigned short offset = mem_block[A_PROGRAM].current_size;
  1536.  
  1537.     while(mem_block[A_LINENUMBERS].current_size / sizeof (short) <
  1538.       current_line)
  1539.     {
  1540.     add_to_mem_block(A_LINENUMBERS, (char *)&offset, sizeof offset);
  1541.     }
  1542. }
  1543.  
  1544. static char *get_type_name(type)
  1545.     int type;
  1546. {
  1547.     static char buff[100];
  1548.     static char *type_name[] = { "unknown", "int", "string",
  1549.                      "void", "object", "mixed", };
  1550.     int pointer = 0;
  1551.  
  1552.     buff[0] = 0;
  1553.     if (type & TYPE_MOD_STATIC)
  1554.     strcat(buff, "static ");
  1555.     if (type & TYPE_MOD_NO_MASK)
  1556.     strcat(buff, "nomask ");
  1557.     if (type & TYPE_MOD_PRIVATE)
  1558.     strcat(buff, "private ");
  1559.     if (type & TYPE_MOD_PROTECTED)
  1560.     strcat(buff, "protected ");
  1561.     if (type & TYPE_MOD_PUBLIC)
  1562.     strcat(buff, "public ");
  1563.     if (type & TYPE_MOD_VARARGS)
  1564.     strcat(buff, "varargs ");
  1565.     type &= TYPE_MOD_MASK;
  1566.     if (type & TYPE_MOD_POINTER) {
  1567.     pointer = 1;
  1568.     type &= ~TYPE_MOD_POINTER;
  1569.     }
  1570.     if (type >= sizeof type_name / sizeof type_name[0])
  1571.     fatal("Bad type\n");
  1572.     strcat(buff, type_name[type]);
  1573.     strcat(buff," ");
  1574.     if (pointer)
  1575.     strcat(buff, "* ");
  1576.     return buff;
  1577. }
  1578.  
  1579. void type_error(str, type)
  1580.     char *str;
  1581.     int type;
  1582. {
  1583.     static char buff[100];
  1584.     char *p;
  1585.     p = get_type_name(type);
  1586.     if (strlen(str) + strlen(p) + 5 >= sizeof buff) {
  1587.     yyerror(str);
  1588.     } else {
  1589.     strcpy(buff, str);
  1590.     strcat(buff, ": \"");
  1591.     strcat(buff, p);
  1592.     strcat(buff, "\"");
  1593.     yyerror(buff);
  1594.     }
  1595. }
  1596.  
  1597. /*
  1598.  * Compile an LPC file.
  1599.  */
  1600. void compile_file() {
  1601.     int yyparse();
  1602.  
  1603.     prolog();
  1604.     yyparse();
  1605.     epilog();
  1606. }
  1607.  
  1608. static char *get_two_types(type1, type2)
  1609.     int type1, type2;
  1610. {
  1611.     static char buff[100];
  1612.  
  1613.     strcpy(buff, "( ");
  1614.     strcat(buff, get_type_name(type1));
  1615.     strcat(buff, "vs ");
  1616.     strcat(buff, get_type_name(type2));
  1617.     strcat(buff, ")");
  1618.     return buff;
  1619. }
  1620.  
  1621. /*
  1622.  * The program has been compiled. Prepare a 'struct program' to be returned.
  1623.  */
  1624. void epilog() {
  1625.     int size, i;
  1626.     char *p;
  1627.     struct function *funp;
  1628.     static int current_id_number = 1;
  1629.  
  1630. #ifdef DEBUG
  1631.     if (num_parse_error == 0 && type_of_arguments.current_size != 0)
  1632.     fatal("Failed to deallocate argument type stack\n");
  1633. #endif
  1634.     /*
  1635.      * Define the __INIT function, but only if there was any code
  1636.      * to initialize.
  1637.      */
  1638.     if (first_last_initializer_end != last_initializer_end) {
  1639.     define_new_function("__INIT", 0, 0, 0, 0, 0);
  1640.     /*
  1641.      * Change the last jump after the last initializer into a
  1642.      * return(1) statement.
  1643.      */
  1644.     mem_block[A_PROGRAM].block[last_initializer_end-1] =
  1645.         F_CONST1 - F_OFFSET;
  1646.     mem_block[A_PROGRAM].block[last_initializer_end-0] =
  1647.         F_RETURN - F_OFFSET;
  1648.     }
  1649.  
  1650.     /*
  1651.      * If functions are undefined, replace them by definitions done
  1652.      * by inheritance. All explicit "name::func" are already resolved.
  1653.      */
  1654.     for (i = 0; i < mem_block[A_FUNCTIONS].current_size; i += sizeof *funp) {
  1655.     funp = (struct function *)(mem_block[A_FUNCTIONS].block + i);
  1656.     if (!(funp->flags & NAME_UNDEFINED))
  1657.         continue;
  1658.     find_inherited(funp);
  1659.     }
  1660.     if (num_parse_error > 0) {
  1661.     prog = 0;
  1662.     for (i=0; i<NUMAREAS; i++)
  1663.         free(mem_block[i].block);
  1664.     return;
  1665.     }
  1666.     size = align(sizeof (struct program));
  1667.     for (i=0; i<NUMPAREAS; i++)
  1668.     size += align(mem_block[i].current_size);
  1669.     p = (char *)xalloc(size);
  1670.     prog = (struct program *)p;
  1671.     *prog = NULL_program;
  1672.     prog->total_size = size;
  1673.     prog->ref = 0;
  1674.     prog->heart_beat = heart_beat;
  1675.     prog->name = string_copy(current_file);
  1676.     prog->id_number = current_id_number++;
  1677.     total_prog_block_size += prog->total_size;
  1678.     total_num_prog_blocks += 1;
  1679.  
  1680.     p += align(sizeof (struct program));
  1681.     prog->program = p;
  1682.     if (mem_block[A_PROGRAM].current_size)
  1683.     memcpy(p, mem_block[A_PROGRAM].block,
  1684.            mem_block[A_PROGRAM].current_size);
  1685.     prog->program_size = mem_block[A_PROGRAM].current_size;
  1686.  
  1687.     p += align(mem_block[A_PROGRAM].current_size);
  1688.     prog->line_numbers = (unsigned short *)p;
  1689.     if (mem_block[A_LINENUMBERS].current_size)
  1690.     memcpy(p, mem_block[A_LINENUMBERS].block,
  1691.            mem_block[A_LINENUMBERS].current_size);
  1692.  
  1693.     p += align(mem_block[A_LINENUMBERS].current_size);
  1694.     prog->functions = (struct function *)p;
  1695.     prog->num_functions = mem_block[A_FUNCTIONS].current_size /
  1696.     sizeof (struct function);
  1697.     if (mem_block[A_FUNCTIONS].current_size)
  1698.     memcpy(p, mem_block[A_FUNCTIONS].block,
  1699.            mem_block[A_FUNCTIONS].current_size);
  1700.  
  1701.     p += align(mem_block[A_FUNCTIONS].current_size);
  1702.     prog->strings = (char **)p;
  1703.     prog->num_strings = mem_block[A_STRINGS].current_size /
  1704.     sizeof (char *);
  1705.     if (mem_block[A_STRINGS].current_size)
  1706.     memcpy(p, mem_block[A_STRINGS].block,
  1707.            mem_block[A_STRINGS].current_size);
  1708.  
  1709.     p += align(mem_block[A_STRINGS].current_size);
  1710.     prog->variable_names = (struct variable *)p;
  1711.     prog->num_variables = mem_block[A_VARIABLES].current_size /
  1712.     sizeof (struct variable);
  1713.     if (mem_block[A_VARIABLES].current_size)
  1714.     memcpy(p, mem_block[A_VARIABLES].block,
  1715.            mem_block[A_VARIABLES].current_size);
  1716.  
  1717.     p += align(mem_block[A_VARIABLES].current_size);
  1718.     prog->num_inherited = mem_block[A_INHERITS].current_size /
  1719.     sizeof (struct inherit);
  1720.     if (prog->num_inherited) {
  1721.     memcpy(p, mem_block[A_INHERITS].block,
  1722.            mem_block[A_INHERITS].current_size);
  1723.     prog->inherit = (struct inherit *)p;
  1724.     } else
  1725.     prog->inherit = 0;
  1726.     
  1727.     prog->argument_types = 0;    /* For now. Will be fixed someday */
  1728.  
  1729.     prog->type_start = 0;
  1730.     for (i=0; i<NUMAREAS; i++)
  1731.         free((char *)mem_block[i].block);
  1732.  
  1733.     /*  marion
  1734.     Do referencing here - avoid multiple referencing when an object
  1735.     inherits more than one object and one of the inherited is already
  1736.     loaded and not the last inherited
  1737.     */
  1738.     reference_prog (prog, "epilog");
  1739.     for (i = 0; i < prog->num_inherited; i++) {
  1740.     reference_prog (prog->inherit[i].prog, "inheritance");
  1741.     }
  1742. }
  1743.  
  1744. /*
  1745.  * Initialize the environment that the compiler needs.
  1746.  */
  1747. static void prolog() {
  1748.     int i;
  1749.  
  1750.     if (type_of_arguments.block == 0) {
  1751.     type_of_arguments.max_size = 100;
  1752.     type_of_arguments.block = xalloc(type_of_arguments.max_size);
  1753.     }
  1754.     type_of_arguments.current_size = 0;
  1755.     approved_object = 0;
  1756.     last_push_indexed = -1;
  1757.     last_push_local = -1;
  1758.     last_push_identifier = -1;
  1759.     prog = 0;        /* 0 means fail to load. */
  1760.     heart_beat = -1;
  1761.     comp_stackp = 0;    /* Local temp stack used by compiler */
  1762.     current_continue_address = 0;
  1763.     current_break_address = 0;
  1764.     num_parse_error = 0;
  1765.     free_all_local_names();    /* In case of earlier error */
  1766.     /* Initialize memory blocks where the result of the compilation
  1767.      * will be stored.
  1768.      */
  1769.     for (i=0; i < NUMAREAS; i++) {
  1770.     mem_block[i].block = xalloc(START_BLOCK_SIZE);
  1771.     mem_block[i].current_size = 0;
  1772.     mem_block[i].max_size = START_BLOCK_SIZE;
  1773.     }
  1774.     add_new_init_jump();
  1775.     first_last_initializer_end = last_initializer_end;
  1776. }
  1777.  
  1778. /*
  1779.  * Add a trailing jump after the last initialization code.
  1780.  */
  1781. void add_new_init_jump() {
  1782.     /*
  1783.      * Add a new jump.
  1784.      */
  1785.     ins_f_byte(F_JUMP);
  1786.     last_initializer_end = mem_block[A_PROGRAM].current_size;
  1787.     ins_short(0);
  1788. }
  1789.